home *** CD-ROM | disk | FTP | other *** search
/ PD Collection CD 1 / PD Collection CD 1.iso / programer2 / siod / !Siod_Scm_other_scm < prev    next >
Encoding:
Text File  |  1993-03-07  |  2.0 KB  |  152 lines
  1. ;;; Answers to some questions out of Scheme and the Art of Programming
  2. ;;; [Springer & Friedman, MIT Press '89]
  3. ;;; Also includes length, first, second, pair and few other bits and bobs
  4. ;;;
  5. ;;; Hacked in an idle moment by Al Slater, those not marked AmS borrowed 8-)
  6.  
  7. (define (first l)
  8.     (car l)
  9. )
  10.  
  11. (define (cadar l)
  12.     (car (cdr (car l)))
  13. )
  14.  
  15. (define (second l)    ; second item in a list
  16.     (car (cdr l))
  17. )
  18.  
  19. (define (second l)    ; tidier
  20.     (cadr l)
  21. )
  22.  
  23. (define (third l)      
  24.     (caddr l)
  25. )
  26.  
  27. (define (pair a b)
  28.     (cons a (cons b '()))
  29. )
  30.  
  31.  
  32. (define (lfy x)
  33.     (cons x '())
  34. )
  35.  
  36. (define (juggle l)   ;;; AmS
  37.  
  38.     (cons      (third l)
  39.          (cons     (car l)
  40.             (lfy (mysec2 l))
  41.         )
  42.     )
  43. )
  44.  
  45. (define (sub1 n)
  46.     (- n 1)
  47. )
  48.  
  49. (define (add1 n)
  50.     (+ n 1)
  51. )
  52.  
  53. (define (length l)
  54.     (if    (null? l)
  55.         0
  56.         (add1 (mylen(cdr l))))
  57. )
  58.  
  59. (define (switch l)    ;;;Ams
  60.  
  61.     (cons     (third l)
  62.         (cons (cadr l) (lfy (car l)))
  63.     )
  64. )
  65.  
  66. (define (mystery ls)
  67.     (if     (null? (cddr ls))
  68.         (cons (car ls) '())
  69.         (cons (car ls) (mystery (cdr ls)))
  70.     )
  71. )
  72.  
  73. (define (subst-1st new old ls)  ;;; AmS
  74.     (if     (null? (car ls))
  75.         '()                                ;;; if ls.hd == ()
  76.         (if    (equal? (car ls) old)
  77.             (cons new (cdr ls))        ;;; if found replace new item
  78.  
  79.             ;;; otherwise recurse
  80.             (cons (car ls) (subst-1st new old (cdr ls)))  
  81.         )
  82.     )
  83. )
  84.  
  85. (define (fact n)
  86.     (if (< n 2)
  87.         1
  88.         (* n (fact (sub1 n)))
  89.     )
  90. )
  91.  
  92. (define (last l)      ;;; AmS
  93.     (if (null? (cdr l))
  94.         (car l)
  95.         (last (cdr l))
  96.     )
  97. )
  98.  
  99.  
  100. (define (reverse l)
  101.     (if (null? l)
  102.         '()
  103.  
  104.         (append
  105.             (reverse (cdr l))
  106.             (list (if     (pair? (car l))
  107.                     (reverse (car l))
  108.                     (car l)))
  109.         ) 
  110.     )
  111. )
  112.  
  113. (define (singleton? x)
  114.     (if (and (pair? x) (null? (cdr x)))
  115.         't
  116.         'f
  117.     )
  118. )
  119.  
  120. (define (member? x l) ;;; AmS
  121.     (if (equal? x (car l))
  122.         't
  123.         (if (and (null? (cdr l)) (not (equal? x (car l))))
  124.             'f
  125.             (member? x (cdr l))
  126.         )
  127.     )
  128. )
  129.  
  130. (define (mapcar f l) ;;; + AmS Dg
  131.     (if (null? (car l))
  132.         '()
  133.         (cons     (f(car l))
  134.             (mapcar f (cdr l))
  135.         )
  136.     )
  137. )
  138.  
  139. (define (addl l) ;;; + AmS Dg
  140.     (if (null? (car l))
  141.         0
  142.         (+ (car l) (addl (cdr l)))
  143.     )
  144. )
  145.  
  146. (define (nth x l) ;;; AmS
  147.     (if (equal? x 1)
  148.         (car l)
  149.         (nth (- x 1)(cdr l))
  150.     )
  151. )
  152.